VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Filehashtable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Filehashtable class. Creates a has table in a file.
'Made on 28/08/06

Private Type hashtble
    key As String * 100
    data As String * 100
End Type

Dim hashsize As Long 'how big is our hash table
Dim fpoint As Long 'The file pointer for the filehashtable
Dim cfname As String 'The filename of the filehashtable
Dim init As Boolean 'are we initialized?
Private Function hashfunc(x As String) As Long
cnt = 13

For y = 1 To Len(x)
cnt = cnt + (Asc(Mid(x, y, 1)) * (13 ^ (y)))
cnt = cnt - (Int(cnt / hashsize) * hashsize)
Next y


cnt = cnt - (Int(cnt / hashsize) * hashsize)

cnt = cnt + 1

hashfunc = cnt
End Function

Public Sub resize(sze As Long)
Dim B As Byte
Dim htb As hashtble
If Not init Then Exit Sub

If LOF(fpoint) < (sze * Len(htb) + Len(htb)) Then Put #fpoint, sze * Len(htb) + Len(htb), B
If LOF(fpoint) > (sze * Len(htb) + Len(htb)) Then
    Close #fpoint
    Open cfname For Output As #fpoint
    Print #fpoint, ""
    Close #fpoint
    Open cfname For Binary As #fpoint
    Put #fpoint, sze * Len(htb) + Len(htb), B
End If

hashsize = sze
End Sub

Public Sub putval(key As String, data As String)
Dim hkey As Long
Dim htable As hashtble
If Not init Then Exit Sub

hkey = hashfunc(key) * Len(htable) 'Find the point in the file where it should be

Do 'Look for either the origional key (to rewrite), or a null value. (so that you can add a new value).
Get #fpoint, hkey, htable
If Trim(Replace(htable.key, Chr(0), "")) = "" Or Trim(Replace(htable.key, Chr(0), "")) = Trim(key) Then Exit Do
hkey = hkey + Len(htable)
miss = miss + 1
Loop

htable.key = key
htable.data = data

Put #fpoint, hkey + 1, htable
End Sub

Public Function getval(key As String) As String
Dim hkey As Long
Dim htable As hashtble
If Not init Then Exit Function

hkey = hashfunc(key) * Len(htable)

Do 'Look for for either a null value (indicating it doesn't exist), or else the right value.
Get #fpoint, hkey + 1, htable
If Trim(Replace(htable.key, Chr(0), "")) = "" Or Trim(Replace(htable.key, Chr(0), "")) = Trim(key) Then Exit Do
hkey = hkey + Len(htable)
miss = miss + 1
Loop

If Trim(htable.key) = Trim(key) Then getval = Trim(htable.data)
End Function

Public Sub initialize(fname As String)
fpoint = FreeFile 'Find a free file pointer and open the filehashtable
Open fname For Binary As fpoint

Dim ht As hashtble
hashsize = (LOF(fpoint) / Len(ht)) - 1
cfname = fname
init = True
End Sub

Private Sub Class_Terminate()
Close #fpoint 'Close the file, because the object is being terminated
End Sub
